home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Magnum One
/
Magnum One (Mid-American Digital) (Disc Manufacturing).iso
/
d18
/
gsdb21.arc
/
GS_KEYI.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-01-04
|
23KB
|
511 lines
{
Keyboard Input Routines
GS_KeyI Copyright (c) Richard F. Griffin
9 April 1990
102 Molded Stone Pl
Warner Robins, GA 31088
-------------------------------------------------------------
This unit handles the objects for all keyboard data entry
operations.
The following example shows how this unit may be used in conjunction
with the GS_DB_FL unit to create a screen menu. The AcceptField
method actually calls the EditString method and stores the result.
The programmer can handle the cursor commands to move around the
different fields in the following way. Note that Escape allows an
abort of the procedure, while Ctrl-End is the normal way to exit:
procedure HlthData_Objct.Accept;
var
fpos : integer;
fini : boolean;
begin
fpos := 1;
fini := false;
while not fini do
begin
case fpos of
1 : F_CODE.PutField(F_CODE.AcceptField(1,1,' F_CODE: '));
2 : L_NAME.PutField(L_NAME.AcceptField(1,2,' L_NAME: '));
3 : M_DATE.PutField(M_DATE.AcceptField(1,3,' M_DATE: '));
end;
case GS_KeyI_Chr of
Kbd_RTb,
Kbd_UpAr : if fpos > 1 then dec(fpos);
Kbd_CEnd : fini := true;
Kbd_CHom : fpos := 1;
else inc(fpos);
end;
if fpos > 3 then fpos := 1;
if (GS_KeyI_Esc) or (fini) then exit;
end;
end;
}
{.pa}
{
┌─────────────────────┐
│ INTERFACE SECTION │
└─────────────────────┘
}
unit GS_KeyI;
interface
uses
CRT, DOS, GS_Scrn;
const
BeepTime = 200;
BeepFreq = 600;
Kbd_Null = #0; {Null Character}
Kbd_Nul = #3; {Another Null}
Kbd_Bsp = #8; {Backspace}
Kbd_Tab = #9; {Tab}
Kbd_Ret = #13; {Return}
Kbd_RTb = #15; {Shift-Tab}
Kbd_AlQ = #16; {Alt-Q}
Kbd_AlW = #17; {Alt-W}
Kbd_AlE = #18; {Alt-E}
Kbd_AlR = #19; {Alt-R}
Kbd_AlT = #20; {Alt-T}
Kbd_AlY = #21; {Alt-Y}
Kbd_AlU = #22; {Alt-U}
Kbd_AlI = #23; {Alt-I}
Kbd_AlO = #24; {Alt-O}
Kbd_AlP = #25; {Alt-P}
Kbd_Esc = #27; {Escape}
Kbd_AlA = #30; {Alt-A}
Kbd_AlS = #31; {Alt-S}
Kbd_AlD = #32; {Alt-D}
Kbd_AlF = #33; {Alt-F}
Kbd_AlG = #34; {Alt-G}
Kbd_AlH = #35; {Alt-H}
Kbd_AlJ = #36; {Alt-J}
Kbd_AlK = #37; {Alt-K}
Kbd_AlL = #38; {Alt-L}
Kbd_AlZ = #44; {Alt-Z}
Kbd_AlX = #45; {Alt-X}
Kbd_AlC = #46; {Alt-C}
Kbd_AlV = #47; {Alt-V}
Kbd_AlB = #48; {Alt-B}
Kbd_AlN = #49; {Alt-N}
Kbd_AlM = #50; {Alt-M}
Kbd_F1 = #59; {F1}
Kbd_F2 = #60; {F2}
Kbd_F3 = #61; {F3}
Kbd_F4 = #62; {F4}
Kbd_F5 = #63; {F5}
Kbd_F6 = #64; {F6}
Kbd_F7 = #65; {F7}
Kbd_F8 = #66; {F8}
Kbd_F9 = #67; {F9}
Kbd_F10 = #68; {F10}
Kbd_Home = #71; {Home}
Kbd_UpAr = #72; {Up Arrow}
Kbd_PgUp = #73; {Page Up}
Kbd_LfAr = #75; {Left Arrow}
Kbd_RtAr = #77; {Right Arrow}
Kbd_End = #79; {End}
Kbd_DnAr = #80; {Down Arrow}
Kbd_PgDn = #81; {Page Down}
Kbd_Ins = #82; {Insert}
Kbd_Del = #83; {Delete}
Kbd_F11 = #84; {Shift-F1}
Kbd_F12 = #85; {Shift-F2}
Kbd_F13 = #86; {Shift-F3}
Kbd_F14 = #87; {Shift-F4}
Kbd_F15 = #88; {Shift-F5}
Kbd_F16 = #89; {Shift-F6}
Kbd_F17 = #90; {Shift-F7}
Kbd_F18 = #91; {Shift-F8}
Kbd_F19 = #92; {Shift-F9}
Kbd_F20 = #93; {Shift-F10}
Kbd_F21 = #94; {Ctrl-F1}
Kbd_F22 = #95; {Ctrl-F2}
Kbd_F23 = #96; {Ctrl-F3}
Kbd_F24 = #97; {Ctrl-F4}
Kbd_F25 = #98; {Ctrl-F5}
Kbd_F26 = #99; {Ctrl-F6}
Kbd_F27 = #100; {Ctrl-F7}
Kbd_F28 = #101; {Ctrl-F8}
Kbd_F29 = #102; {Ctrl-F9}
Kbd_F30 = #103; {Ctrl-F10}
Kbd_F31 = #104; {Alt-F1}
Kbd_F32 = #105; {Alt-F2}
Kbd_F33 = #106; {Alt-F3}
Kbd_F34 = #107; {Alt-F4}
Kbd_F35 = #108; {Alt-F5}
Kbd_F36 = #109; {Alt-F6}
Kbd_F37 = #110; {Alt-F7}
Kbd_F38 = #111; {Alt-F8}
Kbd_F39 = #112; {Alt-F9}
Kbd_F40 = #113; {Alt-F10}
Kbd_CPSc = #114; {Ctrl-PrtSc}
Kbd_CLAr = #115; {Ctrl-Left Arrow}
Kbd_CRAr = #116; {Ctrl-Right Arrow}
Kbd_CEnd = #117; {Ctrl-End}
Kbd_CPDn = #118; {Ctrl-Page Down}
Kbd_CHom = #119; {Ctrl-Home}
Kbd_Al1 = #120; {Alt-1}
Kbd_Al2 = #121; {Alt-2}
Kbd_Al3 = #122; {Alt-3}
Kbd_Al4 = #123; {Alt-4}
Kbd_Al5 = #124; {Alt-5}
Kbd_Al6 = #125; {Alt-6}
Kbd_Al7 = #126; {Alt-7}
Kbd_Al8 = #127; {Alt-8}
Kbd_Al9 = #128; {Alt-9}
Kbd_Al0 = #129; {Alt-0}
Kbd_AlHy = #130; {Alt-Hyphen}
Kbd_AlEq = #131; {Alt-Equal}
Kbd_CPUp = #132; {Ctrl-Page up}
type
{
┌──────────────────────────────────────────────────────────┐
│ ******** Object for Keyboard Entry Action ******* │
│ │
│ This object type describes the structure for any child │
│ so that the child object can use a virtual method to │
│ handle processing of function keys. │
└──────────────────────────────────────────────────────────┘
}
GS_KeyI_Objt = Object
CPos : Word;
{Holds the position within the string}
Ch : Char;
{Holds the last character read}
First : boolean;
{Flag to detect the first real character}
{entered from the keyboard}
Modified : boolean;
{Flag to signal whether the field was}
{mofified, or the default was returned}
Wait_CR : boolean;
{Flag to wait for Carriage Return before}
{exit. If false, will exit when the}
{field is full}
constructor Init;
function EditString(T : string; x, y, l : integer)
: string;
procedure Check_Func_Keys; virtual;
{Note this method is virtual, so it may}
{be replaced by any child method for its}
{own processing of function key actions}
end;
var
GS_KeyI_Esc,
GS_KeyI_Fuc,
GS_KeyI_Ins,
GS_KeyI_Ret : boolean;
GS_KeyI_Chr : char;
GS_KeyI_Str : string[255];
Function GS_KeyI_GetKey : char; {Any program can call this to read a}
{character and test for function keys}
procedure WaitForKey;
procedure SoundBell( t,h : word);
implementation
procedure SoundBell( t,h : word);
begin
Sound(h);
Delay(t);
NoSound;
end;
procedure WaitForKey;
var
c : char;
begin
c := GS_KeyI_GetKey;
end;
{.pa}
{
GS_KEYI_GETKEY
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The GS_KeyI_GetKey function is used to read a character from ║
║ Keyboard. It can be called from any program. ║
║ ║
║ Calling the Function: ║
║ ║
║ Ch := GS_KeyI_GetKey ║
║ ║
║ ( where Ch is of type char. ) ║
║ ║
║ Result: ║
║ ║
║ A character is returned. If it is a function key, ║
║ GS_KeyI_Func is set true. The character is also ║
║ saved in GS_KeyI_Chr, a global variable (just in ║
║ case it is needed at a later date) ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
Function GS_KeyI_GetKey : char;
var
ch: char;
begin
Ch := ReadKey; {Use TP ReadKey Function}
If (Ch = #0) then {It must be a function key }
begin
Ch := ReadKey; {So read the function code}
GS_KeyI_Fuc := true; {Set function flag}
end
else GS_KeyI_Fuc := false;
GS_KeyI_Chr := Ch; {Save in a global variable for general}
{principle.}
GS_KeyI_GetKey := Ch; {Return character}
end;
{.pa}
{
INIT
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The INIT method initializes objectname by setting flags to ║
║ false. More importantly, it links the virtual method table. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.Init ║
║ ║
║ ( where objectname is of type GS_KeyI_Objt ) ║
║ ║
║ Result: ║
║ ║
║ object is initialized. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
constructor GS_KeyI_Objt.Init;
begin
Wait_CR := true; {Wait for Carriage Return on field edit}
end;
{.pa}
{
EDITSTRING
╔══════════════════════════════════════════════════════════════════╗
║ ║
║ The EDITSTRING method will allow onscreen editing of a data ║
║ string. It allows use of cursor keys and tabs as well. ║
║ ║
║ Calling the Method: ║
║ ║
║ objectname.EditString(St,x,y,lgth) ║
║ ║
║ ( where objectname is of type GS_KeyI_Objt ║
║ St is a string default value, ║
║ x is the screen column position to start, ║
║ y is the screen row position to start, ║
║ lgth is the maximum field length ) ║
║ ║
║ Result: ║
║ ║
║ An edited string is returned. If Escape is pressed, ║
║ the original default value is returned. ║
║ ║
╚══════════════════════════════════════════════════════════════════╝
}
{
┌──────────────────────────────────────────────────────────┐
│ ******** Function Key Processor ******* │
│ │
│ This routine processes any function key that is pressed │
│ during edit mode. If it is one ether insert is on or │
│ off. BIOS calls are used. │
└──────────────────────────────────────────────────────────┘
}
procedure GS_KeyI_Objt.Check_Func_Keys;
begin
case Ch of
Kbd_Home : CPos := 1; {Home key sets cursor to start}
Kbd_End : CPos := Succ(Length(GS_KeyI_Str));
{End key sets cursor to string length + 1}
Kbd_Ins : begin {Insert Key switches insert flag}
GS_KeyI_Ins := not GS_KeyI_Ins;
{Set insert flag to opposite}
GS_Scrn_SetCursor(GS_KeyI_Ins);
{Go set cursor to line or large based on}
{insert flag true/false}
end;
Kbd_LfAr : if CPos > 1 then Dec(CPos);
{Left Arrow will backup cursor 1 position}
Kbd_RtAr : if CPos <= Length(GS_KeyI_Str) then Inc(CPos);
{Right Arrow will advance cursor}
Kbd_Bsp : {Backspace will delete char to the left}
if CPos > 1 then
begin
Delete(GS_KeyI_Str, Pred(CPos), 1);
Dec(CPos);
end;
Kbd_Del : {Delete will delete char at cursor}
if CPos <= Length(GS_KeyI_Str) then
Delete(GS_KeyI_Str, CPos, 1);
{
┌──────────────────────────────────────────────────────────┐
│ The following keys will simulate the Return key being │
│ pressed. The actual key pressed can be tested by the │
│ calling program using the character in GS_KeyI_Chr, │
│ using the Kbd_xxx constant values. │
└──────────────────────────────────────────────────────────┘
}
Kbd_Tab, {Tab Key}
Kbd_Rtb, {Shift-Tab key}
Kbd_UpAr, {Up Arrow}
Kbd_DnAr, {Down Arrow}
Kbd_PgUp, {Page Up}
Kbd_PgDn, {Page Down}
Kbd_CEnd, {Ctrl-End}
Kbd_CHom, {Ctrl-Home}
Kbd_Ret : begin {Return}
GS_KeyI_Ret := true;
{Set Return Flag true}
Ch := Kbd_Ret;
end;
Kbd_Esc : begin {Escape Key causes an exit with the}
{original default value returned}
GS_KeyI_Str := '';
GS_KeyI_Esc := True;
end;
end;
end;
{
┌──────────────────────────────────────────────────────────┐
│ ******** Edit String Procedure ******* │
│ │
│ This is the main method to edit an input string. The │
│ usual cursor keys are processed through a method that │
│ may be replaced by a child object's virtual method. │
│ The Escape key will terminate and return the default │
│ value to the calling program. │
└──────────────────────────────────────────────────────────┘
}
function GS_KeyI_Objt.EditString(T : string; x, y, l : integer) : string;
begin
GS_KeyI_Ins := True; {Start in insert mode}
GS_KeyI_Esc := False; {Set the Escape flag false}
GS_KeyI_Ret := false; {Set Return flag false}
Modified := false; {Flag for field not modified}
First := True; {Flag set for no characters yet entered}
GS_KeyI_Str := T; {Store default value in work string}
GS_Scrn_SetCursor(GS_KeyI_Ins); {Go set cursor size}
CPos := 1; {Set cursor position on line to start}
repeat
gotoxy(x,y); {Go to proper location on screen}
write(GS_KeyI_Str,'':l-length(GS_KeyI_Str));
{Display the work string}
GotoXY(CPos+x-1, y); {Go to current position in the string}
Ch := GS_KeyI_GetKey; {Get the next keyboard entry}
if (GS_KeyI_Fuc) or (Ch in [#0..#31]) then
{See if function key or control char}
begin
Check_Func_Keys; {If it is, go process it. Note this is}
{a virtual method that may go to a child}
{object's method}
end
else {Otherwise add character to the string}
begin
{
┌─────────────────────────────────────────────┐
│ If this is the very first character to │
│ be pressed, clear the work string first. │
│ This allows editing of the work string │
│ if cursor keys are used before a character │
│ is entered, or total replacement by │
│ pressing a character key first. │
└─────────────────────────────────────────────┘
}
if First then
begin
GS_KeyI_Str := '';
end;
{
┌─────────────────────────────────────────────┐
│ If insert is on then insert the character. │
│ Otherwise, if at the end of the string, │
│ just add the new character. If insert is │
│ off and not at the end of the string, │
│ replace the existing character. │
└─────────────────────────────────────────────┘
}
if (GS_KeyI_Ins) then Insert(Ch, GS_KeyI_Str, CPos)
else if CPos > Length(GS_KeyI_Str) then
GS_KeyI_Str := GS_KeyI_Str + Ch
else GS_KeyI_Str[CPos] := Ch;
Inc(CPos); {Step to the next location in the string}
end;
First := False; {Set first character flag to false}
if length(GS_KeyI_Str) > l then
{If string is longer than allowed}
begin
SoundBell(BeepTime,BeepFreq);
delete(GS_KeyI_Str,length(GS_KeyI_Str),1);
{Remove the last character in the string}
dec(CPos); {Back up one position}
end;
if (CPos > l) then
if (not Wait_CR) and (Ch <> Kbd_End) then
begin
Ch := Kbd_Ret;
GS_KeyI_Ret := true; {If field is full and no need to wait}
end {for a carriage return, simulate one}
else CPos := l;
until (Ch = Kbd_Ret) or (Ch = Kbd_Esc);
{Continue until Return or Escape pressed}
GS_Scrn_SetCursor(False); {Set cursor size to small cursor}
if T = GS_KeyI_Str then Modified := false else Modified := true;
if GS_KeyI_Esc then EditString := T else
EditString := GS_KeyI_Str;
{If Escape key pressed, then return the}
{default value. Otherwise return work}
{string}
end; { EditString }
begin
GS_KeyI_Esc := false;
GS_KeyI_Fuc := false;
GS_KeyI_Ins := false;
GS_KeyI_Ret := false;
GS_KeyI_Chr := #0; {Initialize character to null}
end.
